home *** CD-ROM | disk | FTP | other *** search
10 KEY OFF:CLS 20 PRINT"░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░" 30 PRINT"░┌───────────────────────────────────┐░" 40 PRINT"░│ │░" 50 PRINT"░│ 2032-A.BAS │░" 60 PRINT"░│ RUBIK'S CUBE │░" 70 PRINT"░│ │░" 80 PRINT"░│ │░" 90 PRINT"░│ BROUGHT TO YOU BY THE MEMBERS OF │░" 100 PRINT"░│ ▄▄▄▄▄ ▄▄▄▄▄ ▄▄▄▄▄ ▄▄▄▄▄ │░" 110 PRINT"░│ █ █ █ █ █ █ │░" 120 PRINT"░│ █ █▄▄▄█ █ █ █ │░" 130 PRINT"░│ █ █ █ █ █ │░" 140 PRINT"░│ ▄▄█▄▄ █ █▄▄▄▄ █▄▄▄█ │░" 150 PRINT"░│ │░" 160 PRINT"░│ International PC Owners │░" 170 PRINT"░│ │░" 180 PRINT"░│P.O. Box 10426, Pittsburgh PA 15234│░" 190 PRINT"░│ │░" 200 PRINT"░└───────────────────────────────────┘░" 210 PRINT"░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░" 220 PRINT 230 PRINT " PRESS ANY KEY TO CONTINUE 240 A$=INKEY$: IF A$="" THEN 240 250 CLS 1000 ' *********************************** 1010 ' *** RUBIK'S CUBE SIMULATOR *** Compliments of 1020 ' *** PC MAGAZINE *** UTAH BLUE CHIPS 1030 ' *** March. 1982 *** IBM PC Users Group 1040 ' *** Karl Koessel *** 1050 ' *** *** December 1982 1060 ' *********************************** 1070 SCREEN 0,1,0,0' Text mode,color on,active page,visual page 1080 COLOR 7,0,1' Print white on black.Border on color monitor 1090 CLS' Clear screen 1100 KEY OFF' Turn off soft keys display on line 25 1110 CLEAR,,2000' Clear some work space 1120 DEFINT A-Z' Variables are all integers 1130 DIM HOLD(20)' This array has subscripts greater than 10 1140 GOSUB 4260' Read constants 1150 GOSUB 4680' Initialize variables 1160 GOSUB 4740' Display title page 1170 GOSUB 4830' Input color of faces 1180 GOSUB 1620' Get a new cube 1190 '******************** INPUT ROUTINES ***************************** 1200 '************ First input, requests a twist or command 1210 GOSUB 3780' Find proper location 1220 COLOR 23' Blink ... 1230 PRINT "Enter ";' ... beginning of input prompt 1240 COLOR 7' Normal foreground 1250 INPUT "a twist or command: ";TWIST$' Finish prompt, no question mark 1260 IF TWIST$="" THEN 1210' Operator silent? let's ask again 1270 GOSUB 2880' Input received clear input lines 1280 REQ$=TWIST$' Copy input for testing routines 1290 GOSUB 1840' Check for a valid command, if so 1300 IF D THEN 1210' it's done-go back to first input 1310 GOSUB 1930' Else check for a valid twist 1320 GOTO 1210' Loop back for next twist/command 1330 '************ Second input request ok to proceed 1340 GOSUB 3780' Find proper location 1350 PRINT "Press [RETURN] to twist the ";' Begin second input promt 1360 IF CLRMON THEN COLOR BR(F) ELSE COLOR 1' Emphasize the ... 1370 PRINT PLACE$(1,F);' ... name of the chosen face 1380 COLOR 7' Normal foreground 1390 PRINT " face ";' Middle of second input prompt 1400 IF CLRMON THEN COLOR BR(F) ELSE COLOR 1' Emphasize the ... 1410 PRINT DIRECTION$(OSO)' ... direction of the twist 1420 COLOR 7' Normal foreground 1430 IF CLRMON AND BIG THEN 1450' Skip spacing? 1440 PRINT SPC(13)' Print spaces on WIDTH 80 display 1450 PRINT "or enter a new twist or command: ";'Finish second input prompt. 1460 INPUT "",GO$' Comma instead of semicolon suppresses question mark! 1470 GOSUB 2880' Input received-clear input lines 1480 IF GO$="" THEN 1550' If blank, go finish twist, else 1490 REQ$=GO$' Copy input for testing routines 1500 GOSUB 1840' Check for a command, if so do it 1510 ON D GOTO 1340,1340,1340,1340,1530,1340,1340,1340,1550' and continue accordingly 1520 GOSUB 1930' else check for a valid twist 1530 RETURN' Invalid 2nd input, return to 1st 1540 '********* If GO$="" then finish the twist ! 1550 GOSUB 3380' Finish turning outer circle 1560 GOSUB 3540' Finish turning chosen face 1570 GOSUB 2920' Turn off highlight flags 1580 GOSUB 3020' Update "twists so far' 1590 GOSUB 2610' Print new cube 1600 RETURN' Return to first input 1610 '*************** NEW-ING AND HELP SEQUENCES ************************* 1620 GOSUB 2920' Turn off any highlights 1630 IF CLRMON THEN WIDTH 40:BIG=-1' Set to WIDTH 40.Set big flag on 1640 IF NOT BIG AND D=8 THEN RETURN' HELP is already on the screen 1650 GOSUB 3810' Clear screen, print instructions 1660 IF D<>8 THEN GOSUB 3630' If not HELP, reinitialize cubies 1670 IF NOT BIG THEN 1710' WIDTH 80 display skips waiting 1680 GOSUB 4040' Wait routine for WIDTH 40 1690 CLS' Clear screen 1700 GOSUB 4060' Print title on line 25 1710 GOSUB 2310' Reprint display 1720 RETURN' If NEW, return to 1st input. If HELP, return to what you were doing 1730 '******************* TURN INPUT INTO UPPER CASE ********************** 1740 RQ$=""' Blank new (upper case) string 1750 FOR K=1 TO LEN(REQ$)' For each character of input 1760 RK$=MID$(REQ$,K,1)' Set a character 1770 IF RK$="'" THEN 1790' If prime, skip character change 1780 RK$=CHR$((ASC(RK$) AND 95))' Change to upper case character 1790 RQ$=RQ$+RK$' Add character to new string 1800 NEXT 1810 REQ$=RQ$' Set old string to a new string 1820 RETURN' All uppercase, ready to check 1830 '*************** TO CHECK FOR VALID COMMAND ************************* 1840 GOSUB 1740' Convert input to upper case 1850 D=0' Valid command flag set to 'no' 1860 FOR DMI=1 TO 9' Check for valid command. if so, 1870 IF LEFT$(REQ$,LEN(DM$(DMI)))=DM$(DMI) THEN D=DMI' ...set flag to 'yes' 1880 NEXT 1890 IF D>0 AND D<4 THEN DM=D-1' If display type, set type flag 1900 ON D GOSUB 2610,2610,2610,2400,1620,2230,3060,1630,2370' Do it ... 1910 RETURN' ... and/or return 1920 '******************* TO CHECK FOR VALID TWIST *********************** 1930 GOSUB 2920' First turn off highlights that may be on 1940 '******** Then check if 2nd character valid and input length =2 or less 1950 IF MID$(REQ$,2,1)="" OR MID$(REQ$,2,1)="'" AND LEN(REQ$)<3 THEN 1980 1960 GOTO 2040' Invalid input 1970 '******** Check first character of input for a valid twist 1980 F=0' Deselect face 1990 FOR W=1 TO LEN(T$)' If twist is valid, set F to face number... 2000 IF LEFT$(REQ$,1)=MID$(T$,W,1) THEN F=W:TWIST$=REQ$' ...and reset TWIST$ 2010 NEXT 2020 IF F THEN 2120' If face valid, go to prepare for 2nd input 2030 '********* Invalid input 2040 GOSUB 3780' Locate prompt line, print message 2050 PRINT "Input ";:COLOR 23:PRINT "NOT";:COLOR 7:PRINT " recognized" 2060 PRINT " One moment please..." 2070 GOSUB 2610' Reprint display without highlights 2080 GOSUB 2880' Clear input prompt lines Use Skip to resume/ 2090 RETURN' Restart input 2100 '******************* PREPARE THE SELECTED TWIST ************************ 2110 '********* Find direction, set offsets for inner & outer circular arrays 2120 IF MID$(REQ$,2,1)="'" THEN OSO=2:OSI=1 ELSE OSO=0:OSI=5 2130 '********* Then, for the outer circle ... 2140 GOSUB 3220' Decode array pointers 2150 GOSUB 3280' Set holding cells, turn highlight flags on 2160 '********** Then for the chosen face 2170 GOSUB 3480' Set holding cells, turn highlight flags on 2180 '********** Preparation done ... 2190 IF SKIP THEN 1550' If SKIP, no 2nd input, go finish twist now 2200 GOSUB 2610' Reprint display with highlights 2210 GOTO 1340' Go to second input 2220 '******************* THOSE USING COLOR CAN CHANGE WIDTH ************** 2230 IF NOT CLRMON THEN 2350' This routine is for color monitors only 2240 BIG=NOT BIG' Reverse big flag. -1=WIDTH 40, 0=WIDTH 80 2250 IF BIG THEN WIDTH 40:GOTO 2280'Make the change to WIDTH 40, skip to 1260 2260 WIDTH 80' Make the change to WIDTH 80 2270 GOSUB 3810' For WIDTH 80, print instructions 2280 GOSUB 2310' Display reprinting routine 2290 RETURN' Go to second input 2300 '******************* DISPLAY REPRINTING ROUTINE ********************** 2310 IF BIG THEN GOSUB 4080' Input list for WIDTH 40 display 2320 GOSUB 2410' Reprint labels or blanks without changing flag 2330 GOSUB 2610' Reprint the cube in the new width 2340 IF NOT BIG THEN GOSUB 3060'Reprint twists so far without adding a twist 2350 RETURN' Return to input 2360 '******************* REVERSE SKIP FLAG ******************************* 2370 SKIP=NOT SKIP' -1=SKIP ON, 0=SKIP OFF. WHEN ON, PROGRAM SKIPS 2380 RETURN' second input (request to proceed) 2390 '******************* LABELS ON/OFF ROUTINE *************************** 2400 LABEL = NOT LABEL' Reverse label flag. -1=LABELS ON, 0=LABELS OFF 2410 FOR FA=1 TO 6' For each face 2420 IF BIG THEN LOCATE XBL(FA),YBL(FA):GOTO 2440' Locate for WIDTH 40 or 2430 LOCATE X(FA)+2,Y(FA)-1' Locate under each face & 2440 IF NOT LABEL GOTO 2480' If labels are wanted off 2450 IF CLRMON THEN COLOR BR(FA) ELSE COLOR 1' Emphasize (face's color) 2460 PRINT PLACE$(1,FA);' Print name of face 2470 GOTO 2490' Otherwise... 2480 PRINT SPC(5);' Print blanks over label 2490 NEXT 2500 IF NOT BIG THEN 2590' WIDTH 80 display is done 2510 FOR XBL=1 TO 2' `Front' face has pointer 2520 LOCATE XBL+4,19-XBL' between face and label 2530 IF NOT LABEL THEN GOTO 2560' If labels are wanted off 2540 COLOR BR(3)' Color of front face 2550 PRINT "/";' Make pointer of slashes 2560 PRINT " "' or blank out the slashes 2570 NEXT 2580 COLOR 7' Normal foreground 2590 RETURN' To what you were doing 2600 '******************* CUBE PRINTING TOURTINE ************************** 2610 DB=1:DUB=0' Initialize display formatting variables 2620 IF BIG THEN BD=2' Double this variable for WIDTH 40 2630 FOR FA=1 TO 6' For each face 2640 FOR PP=0 TO 8 : P=XOP(PP)' For each cubie on this face 2650 IF BIG THEN FOR DUB=0 TO 1' To square cubie WIDTH 40 prints 2 lines 2660 LOCATE X(FA)+XOF(P)*DB+DUB-REL(FA)*BIG,Y(FA)+YOF(P)+RELY(FA)*BIG'Where 2670 BR=BR(FIX(CUBIE(FA,P,1)\10))' Set background color 2680 IF BR THEN COLOR CUBIE(FA,P,2)*-16,BR:GOTO 2700' Blink foreground? 2690 IF CUBIE(FA,P,2) THEN COLOR 0,7 ELSE COLOR 7,0' Turn on highlights? 2700 IF DUB THEN PRINT " ";:GOTO 2730' Bottom half of cubie 2710 IF DM THEN PRINT USING "\\"; CUBIE$(FA,P,DM); ELSE PRINT USING "##"; CUBIE(FA,P,1);' Print proper type cubie 2720 '************* These lines tidy diplay as colors/highlights change 2730 ON P+1 GOTO 2750,2740,2740,2820,2820,2820,2760,2760,2750' Nine cubies 2740 ND=1:GOTO 2780' Set the `NextDoor' variable for 2750 ND=4:GOTO 2780' six of them so following line 2760 ND=-1:GOTO 2780' can compare neighboring cubies 2770 ' Find proper colors for each side of spaces between cubies 2780 IF BR THEN COLOR BR,BR(FIX(CUBIE(FA,(P+ND) MOD 12,1)\10)) ELSE 2800 2790 PRINT CHR$(221);:GOTO 2820' Left half one color, right half another 2800 IF CUBIE(FA,P,2)=CUBIE(FA,(P+ND) MOD 12,2) THEN 2810 ELSE COLOR 7,0 2810 PRINT " ";' Single space lit or not, for monochrome 2820 IF BIG THEN NEXT ' WIDTH 40 prints 2 lines to square cubie 2830 NEXT 2840 NEXT 2850 COLOR 7,0' NormalizeFOREGROUND, BACKGROUND/ 2860 RETURN 2870 '******************* CLEAR PROMPT/INPUT LINES ************************ 2880 GOSUB 3780' Find proper location (differs on WIDTH 40) 2890 PRINT "One moment, please..."SPC(79)SPC(39)SPC(21)' Clears lines 15 & 16 2900 RETURN' If WIDTH 40 clears lines 19, 20 & 21 2910 '******************* TURN OFF HIGHLIGHT FLAGS ************************ 2920 FOR J=1 TO 4' Four faces touch the chosen face and have ... 2930 FOR K=1 TO 3' Three consecutive cubies touching chosen face 2940 CUBIE(FACE(J),((POSITION(J)+K-2) MOD 8)+1,2)=0' Turn highlight... 2950 NEXT' ...flags `off' 2960 NEXT 2970 FOR P=1 TO 8' All cubies on chosen face except the center 2980 CUBIE(F,P,2)=0' Turn highlight flags `off' 2990 NEXT 3000 RETURN 3010 '******************* KEEP TRACK OF TWISTS **************************** 3020 TWISTSSOFAR$(AT)=TWISTSSOFAR$(AT)+TWIST$+" "' Add valid twist to records 3030 IF LEN(TWISTSSOFAR$(AT))>36 THEN AT=AT+1' Keeps 2 letter twists on 1 line 3040 IF BIG THEN RETURN' WIDTH 40 doesn't print new list 3050 '******************* PRINT LIST OF TWISTS SO FAR ********************* 3060 LOCATE 18,1' Begin at bottom third of screen 3070 IF BIG THEN PRINT ' Down 1 more line for WIDTH 40 3080 COLOR 1' Enphasize list of twists header 3090 PRINT TWISTSSOFAR$(0);' Print header 3100 COLOR 7' Normal foreground 3110 PRINT SPC(13)' Put space between header & list 3120 FOR K=1 TO AT' For each half line of twists 3130 PRINT TWISTSSOFAR$(K);' Print 1st half line. If not big 3140 IF NOT BIG THEN PRINT TWISTSSOFAR$(K+1);:K=K+1' Print 2nd half line 3150 PRINT' Linefeed before end of WIDTH 3160 NEXT 3170 IF NOT BIG THEN RETURN' If WIDTH 80, all done, return 3180 GOSUB 4040' For WIDTH 40, wait to continue, 3190 GOSUB 2880' clear input rpompt lines, 3200 RETURN' then return 3210 '******************* DECODE ARRAY POINTERS FOR OUTER CIRCLE ********** 3220 FOR J=1 TO 4' Four faces touch any chosen face 3230 FACE(J)=VAL(MID$(OC$(F),J*2-1,1))' Which four? Also, from each, the 3240 POSITION(J)=VAL(MID$(OC$(F),J*2,1))' first of the three consecutive 3250 NEXT ' cubies closest to a chosen face 3260 RETURN 3270 '******************* PREPARE TO TURN OUTER CIRCLE ******************** 3280 FOR J=1 TO 4' Four faces touch chosen face... 3290 FOR K=1 TO 3' ...with three consecutive cubies 3300 ' Set cubie value in holding cell 3310 HOLD((J-1)*3+K)=CUBIE(FACE(J),((POSITION(J)+K-2) MOD 8)+1,1) 3320 ' Turn highlight flags `on' 3330 CUBIE(FACE(J),((POSITION(J)+K-2) MOD 8)+1,2)=-1 3340 NEXT 3350 NEXT 3360 RETURN 3370 '******************* FINISH TURNING OUTER CIRCLE ********************* 3380 FOR J=1 TO 4' Four faces touch chosen face... 3390 FOR K=1 TO 3' ...with three consecutive cubies 3400 CUBIE(FACE(((J+OSO) MOD 4)+1),((POSITION(((J+OSO) MOD 4)+1)+K-2) MOD 8)+1,1)=HOLD((J-1)*3+K)' New value of each cubie 3410 FOR DMI=1 TO 2' Associated names follow 3420 CUBIE$(FACE(((J+OSO) MOD 4)+1),((POSITION(((J+OSO) MOD 4)+1) +K-2) MOD 8)+1,DMI)=PLACE$(DMI,FIX((HOLD((J-1)*3+K)\10))) 3430 NEXT 3440 NEXT 3450 NEXT 3460 RETURN 3470 '******************* PREPARE TO TURN CHOSEN FACE ********************* 3480 FOR P=1 TO 8' All cubies on chosen face except the center 3490 HOLD(12+P)=CUBIE(F,P,1)' Put cubie value in holding cell 3500 CUBIE(F,P,2)=-1' Turn highlight flags `on' 3510 NEXT 3520 RETURN 3530 '******************* FINISH TURNING THE CHOSEN FACE ****************** 3540 FOR P=1 TO 8' All cubies on chosen face except the center 3550 CUBIE(F,P,1)=HOLD(13+((P+OSI) MOD 8))' New value of each cubi 3560 FOR DMI=1 TO 2' Associated names follow 3570 CUBIE$(F,P,DMI)=PLACE$(DMI,FIX(CUBIE(F,P,1)\10)) 3580 NEXT 3590 NEXT 3600 RETURN 3610 '******************* SET UP FRESH CUBE ******************************* 3620 'Initialize cubie array to starting values 3630 FOR F=1 TO 6' Six faces on the cube 3640 FOR P=0 TO 9' Nine cubies per face 3650 CUBIE(F,P,1)=F*10+P' Two digit code 3660 FOR DMI=1 TO 2' Associated face ond color 3670 CUBIE$(F,P,DMI)=LEFT$(PLACE$(DMI,F),2) 3680 NEXT 3690 NEXT 3700 NEXT 3710 'Erase accumulated `twists so far' 3720 FOR K=1 TO AT 3730 TWISTSSOFAR$(K)=""' Erase each line 3740 NEXT 3750 AT=1' Begin line index at 1 3760 RETURN 3770 '******************* WIDTH 40 PROMPT LINE RELOCATER ****************** 3780 IF BIG THEN LOCATE 19,1 ELSE LOCATE 15,1' Location of input prompt 3790 RETURN 3800 '******************* CLEAR SCREEN, PRINT INSTRUCTIONS **************** 3810 IF BIG THEN COLOR ,4:BG=3 ELSE BG=43' Set background color, offsets 3820 CLS' Clear screen 3830 LOCATE 1,1+BG:COLOR 1:PRINT TITLES$' Use emphasis where needed 3840 LOCATE 3,3+BG:COLOR 7:PRINT "Each twist is called by the first" 3850 LOCATE 4,BG:PRINT "letter of the face you wish to twist:" 3860 LOCATE 5,BG:COLOR 1:PRINT "U";:COLOR 7:PRINT " for the upper face, "; :COLOR 1:PRINT "L";:COLOR 7:PRINT " for the left" 3870 LOCATE 6,BG:PRINT "face, ";:COLOR 1:PRINT "F";:COLOR 7: :PRINT " for the front face, ";:COLOR 1:PRINT "R";:COLOR 7:PRINT" for the" 3880 LOCATE 7,BG:PRINT "right face, ";:COLOR 1:PRINT "B";:COLOR 7 :PRINT " for the back face and ";:COLOR 1:PRINT "D":COLOR 7 3890 LOCATE 8,BG:PRINT "for the downward face. The twists will" 3900 LOCATE 9,BG:PRINT "be clockwise. To make a counterclock-" 3910 LOCATE 10,BG:PRINT "wise twist, the letter is followed by" 3920 LOCATE 11,BG:PRINT "a ";:COLOR 1:PRINT "'";:COLOR 7:PRINT " (e.g. "; :COLOR 1:PRINT "L'";:COLOR 7:PRINT " ). To change the display," 3930 LOCATE 12,BG:PRINT "enter either the word ";:COLOR 1:PRINT "Labels"; :COLOR 7:PRINT " or ";:COLOR 1:PRINT "Colors";:COLOR 7 3940 IF CLRMON THEN LOCATE 12,BG:PRINT "enter the word ";:COLOR 1:PRINT "Big";: COLOR 7:PRINT" or ";'Additional commands for color monitors 3950 LOCATE 13,BG:PRINT "or ";:COLOR 1:PRINT "Faces";:COLOR 7:PRINT " or "; :COLOR 1:PRINT"Codes";:COLOR 7:PRINT". Use ";:COLOR 1:PRINT "Skip";:COLOR 7 :PRINT " to resume/" 3960 LOCATE 14,BG:PRINT "skip verification. Use ";:COLOR 1:PRINT "New";:COLOR 7 :PRINT " to restart." 3970 IF NOT BIG THEN RETURN' The following commands are for WIDTH 40 3980 LOCATE 15,3:PRINT "To accommodate those using television "; 3990 PRINT " sets (i.e. confined to WIDTH 40), the "; 4000 PRINT " commands ";:COLOR 1:PRINT "List";:COLOR 7:PRINT " & ";:COLOR 1 4010 PRINT "Help";:COLOR 7:PRINT " have been added." 4020 RETURN 4030 '******************* WAIT TO CONTINUE ******************************** 4040 LOCATE 25,9:PRINT "Press the spacebar to continue"; 4050 IF INKEY$<>" " THEN 4050 4060 LOCATE 25,3:COLOR 1,4:PRINT TITLE$;:COLOR 7,0:RETURN 4070 '******************* WIDTH 40 INPUT LIST ***************************** 4080 LOCATE 1,19:COLOR BR(2),,BR(4):PRINT "Twists: "; 4090 FOR LI=1 TO 2:LOCATE LI,25+LI 4100 FOR TI=1 TO 3 4110 FOR DI=0 TO 1 4120 COLOR BR((LI-1)*3+TI) 4130 IF DI THEN PU$="!' " ELSE PU$="! " 4140 PRINT USING PU$;MID$(T$,(LI-1)*3+TI); 4150 NEXT 4160 NEXT 4170 NEXT 4180 LOCATE 4,31:COLOR BR(6):PRINT "Commands:"; 4190 FOR CM=1 TO 9 4200 LOCATE 5+CM,35 4210 COLOR BR(CM MOD 6+1) 4220 PRINT DM$(CM) 4230 NEXT 4240 COLOR 7:RETURN 4250 '******************* READ CONSTANTS ********************************** 4260 FOR FACE=1 TO 6' Six faces 4270 READ PLACE$(1,FACE)' Name and number each face 4280 NEXT 4290 DATA "upper","left","front","right","back","down" 4300 FOR FACE=1 TO 6' If you have a cube that's used frequently, 4310 READ YOURS$(FACE)' put the six names of its colors as data on 4320 NEXT ' line 3310 in proper (see line 3270) order. See REMark on line 4160 4330 DATA "white","orange","blue","red","green","yellow" 4340 FOR P=1 TO 8' Eight cubies surround the center cubie 4350 READ XOF(P),YOF(P)' Offsets to locations of middle cubies for 4360 NEXT ' each neighboring cubie on the same face 4370 DATA -1,-3,-1,0,-1,3,0,3,1,3,1,0,1,-3,0,-3 4380 FOR P=0 TO 8' Modify order of printing cubies of each 4390 READ XOP(P)' face so that none of the lettered face 4400 NEXT ' labels are overwritten. See line 1615. 4410 DATA 1,2,3,8,0,4,7,6,5 4420 FOR FA=1 TO 6' Six faces 4430 READ XBL(FA),YBL(FA)' Locations of labels in WIDTH 40 mode 4440 NEXT 4450 DATA 2,4,13,3,4,19,13,19,13,27,17,17 4460 FOR FA=1 TO 6' Six faces 4470 READ REL(FA),RELY(FA)' Offsets from old to new locations of the 4480 NEXT ' middle cubies of each face 4490 DATA 1,2,3,0,3,2,3,4,3,6,5,2 4500 FOR F=1 TO 6' Six faces 4510 READ X(F),Y(F)' Locations of middle cubies for each face 4520 NEXT 4530 DATA 2,14,6,4,6,14,6,24,6,34,10,14 4540 FOR F=1 TO 6' Six faces 4550 READ OC$(F)' Codes with array indexes to outer circle around each face 4560 NEXT 4570 DATA "21514131","17376753","15476123","13576333","11276543","25354555" 4580 FOR DMI=1 TO 9' Nine recognized commands 4590 READ DM$(DMI)' Valid display types and other commands 4600 NEXT 4610 DATA CODE,FACE,COLOR,LABEL,NEW,BIG,LIST,HELP,SKIP 4620 DIRECTION$(0)="clockwise":DIRECTION$(2)="counterclockwise" 4630 T$="ULFRBD"' Valid twist requests 4640 TWISTSSOFAR$(0)="The list of twists so far :" 4650 TITLE$=SPACE$(7)+"RUBIK'S CUBE SIMULATOR"+SPACE$(7) 4660 RETURN 4670 '******************* INITIALIZE VARIABLES **************************** 4680 DEF SEG=0' Is color monitor present? 4690 IF (PEEK(&H410) AND &H30)<>&H30 THEN CLRMON=-1' If so, set clrmon flag on 4700 DM=1' Set display type for faces 4710 LABEL=-1' Turn label flag on 4720 RETURN 4730 '******************* TITLE PAGE ************************************** 4740 IF CLRMON THEN COLOR 1,4:WIDTH 40:K=1 ELSE WIDTH 80:K=21 4750 CLS:LOCATE 3,2+K:PRINT TITLE$ 4760 LOCATE 6,15+K:PRINT "PC MAGAZINE" 4770 LOCATE ,15+K:COLOR 7:PRINT "March, 1982" 4780 LOCATE 24,19+K:PRINT "press the space bar"; 4790 IF INKEY$<>" " THEN 4790 4800 COLOR 7,0 4810 RETURN 4820 '******************* INPUT A COLOR FOR EACH FACE ********************* 4830 CLS 4840 LOCATE 2,7+K 4850 K$="*** COLORING THE CUBE ***" 4860 'Is color monitor present? 4870 IF CLRMON THEN 4940 4880 'For those using a monochrome monitor 4890 PRINT K$ 4900 LOCATE 9,K+6 4910 PRINT "(The name of each color":PRINT SPC(11+K)"should begin with a": 4920 PRINT SPC(16+K)"different letter.)":GOTO 5140 4930 'For those using a color monitor 4940 FOR L=1 TO 25 4950 COLOR (L MOD 7)+1 4960 PRINT MID$(K$,L,1); 4970 NEXT 4980 LOCATE 4,4 4990 FOR C=1 TO 7' Print a block of color and it's assigned number 5000 COLOR ,C 5010 PRINT " "; 5020 COLOR C,0 5030 PRINT "---";C; 5040 PRINT SPC(10) 5050 NEXT 5060 LOCATE 9,1' Print coloring directions 5070 COLOR 1,4 5080 PRINT "Choose each face's color by entering the"; 5090 PRINT "appropiate number from the list above, "; 5100 COLOR 0,2 5110 PRINT "or just press [RETURN] for each face and"; 5120 PRINT "the computer will choose the colors. " 5130 ' For everybody 5140 LOCATE 15,K 5150 COLOR 23,0:PRINT "Enter"; 5160 COLOR 7:PRINT " a color for each face:" 5170 PRINT 5180 FOR FACE=1 TO 6 5190 LOCATE FACE+16,15+K:COLOR 0,7:PRINT USING " \ \";PLACE$(1,FACE); 5200 COLOR 7,0:INPUT ;" ";PLACE$(2,FACE)' Semicolon before input promt... 5210 IF CLRMON THEN 5250' ...suppresses the usual linefeed 5220 IF PLACE$(2,FACE)="" THEN PLACE$(2,FACE)=YOURS$(FACE)'See REMarks from lines 3280-3300 to name colors by default (null input) for frequently used cube 5230 GOTO 5300 5240 'Again for those using color 5250 IF PLACE$(2,FACE)="" THEN BR(FACE)=FACE:GOTO 5280 ELSE BR(FACE)=VAL(PLACE$(2,FACE)) 5260 IF BR(FACE)<1 OR BR(FACE)>7 THEN LOCATE ,26:PRINT SPC(14):GOTO 5190 5270 IF ASC(PLACE$(2,FACE))<56 THEN PLACE$(2,FACE)=MID$(PLACE$(2,FACE),2) 5280 COLOR 7,0:LOCATE ,24:PRINT "= ";' Print `=' over question mark 5290 COLOR 0,BR(FACE):PRINT PLACE$(2,FACE)+" " 'Print name and block of 5300 NEXT ' selected color 5310 'And finally, again for everybody 5320 COLOR 7,0' Normalize color and 5330 LOCATE 15,K:PRINT "*Chosen ";' Write over blinking prompt 5340 LOCATE 9,K' This writes over coloring directions front ? 5350 COLOR 1,4 5360 PRINT " Check each face and its chosen color. "; 5370 COLOR 7,0 5380 PRINT SPC(79)" "; 5390 LOCATE 11,K 5400 COLOR 5,2 5410 PRINT "Press the spacebar to start over... or,"; 5420 COLOR ,0 5430 PRINT SPC(79)" "; 5440 LOCATE 13,K 5450 COLOR 4,6 5460 PRINT "if everything is oaky press the `g' key." 5470 COLOR 7,0 5480 G$=INKEY$ 5490 IF G$=" "THEN 4830 5500 IF G$<>"G" AND G$<>"g" THEN 5480 5510 RETURN 5520 END key." 5470 COLOR 7,0 5480 G$=INKEY$ 5490 IF 
